home *** CD-ROM | disk | FTP | other *** search
/ Chip 2002 June / Chip_2002-06_cd1.bin / zkuste / delphi / kolekce / d6 / rxlibsetup.exe / {app} / units / RXINI.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  2002-02-19  |  11.6 KB  |  392 lines

  1. {*******************************************************}
  2. {                                                       }
  3. {         Delphi VCL Extensions (RX)                    }
  4. {                                                       }
  5. {         Copyright (c) 2001,2002 SGB Software          }
  6. {         Copyright (c) 1997, 1998 Fedor Koshevnikov,   }
  7. {                        Igor Pavluk and Serge Korolev  }
  8. {                                                       }
  9. {*******************************************************}
  10.  
  11. unit RXIni;
  12.  
  13. interface
  14.  
  15. {$I RX.INC}
  16.  
  17. uses {$IFDEF WIN32} Windows, Registry, {$ELSE} WinTypes, WinProcs, {$ENDIF}
  18.   Classes, IniFiles, Graphics;
  19.  
  20. type
  21.   TReadObjectEvent = function(Sender: TObject; const Section,
  22.     Item, Value: string): TObject of object;
  23.   TWriteObjectEvent = procedure(Sender: TObject; const Section, Item: string;
  24.     Obj: TObject) of object;
  25.  
  26. { TRxIniFile }
  27.  
  28.   TRxIniFile = class(TIniFile)
  29.   private
  30.     FListItemName: String;
  31.     FOnReadObject: TReadObjectEvent;
  32.     FOnWriteObject: TWriteObjectEvent;
  33.     function GetItemName: string;
  34.     procedure SetItemName(const Value: string);
  35.     function ReadListParam(const Section: string; Append: Boolean; List: TStrings): TStrings;
  36.   protected
  37.     procedure WriteObject(const Section, Item: string; Index: Integer; Obj: TObject); dynamic;
  38.     function ReadObject(const Section, Item, Value: string): TObject; dynamic;
  39.   public
  40.     constructor Create(const FileName: string);
  41.     destructor Destroy; override;
  42.     procedure Flush;
  43. {$IFNDEF WIN32}
  44.     procedure DeleteKey(const Section, Ident: String);
  45. {$ENDIF}
  46.     { ini-file read and write methods }
  47.     function ReadClearList(const Section: string; List: TStrings): TStrings;
  48.     function ReadList(const Section: string; List: TStrings): TStrings;
  49.     procedure WriteList(const Section: string; List: TStrings);
  50.     function ReadColor(const Section, Ident: string; Default: TColor): TColor;
  51.     procedure WriteColor(const Section, Ident: string; Value: TColor);
  52.     function ReadFont(const Section, Ident: string; Font: TFont): TFont;
  53.     procedure WriteFont(const Section, Ident: string; Font: TFont);
  54.     function ReadRect(const Section, Ident: string; const Default: TRect): TRect;
  55.     procedure WriteRect(const Section, Ident: string; const Value: TRect);
  56.     function ReadPoint(const Section, Ident: string; const Default: TPoint): TPoint;
  57.     procedure WritePoint(const Section, Ident: string; const Value: TPoint);
  58.     { properties }
  59.     property ListItemName: string read GetItemName write SetItemName;
  60.     property OnReadObject: TReadObjectEvent read FOnReadObject write FOnReadObject;
  61.     property OnWriteObject: TWriteObjectEvent read FOnWriteObject write FOnWriteObject;
  62.   end;
  63.  
  64. function StringToFontStyles(const Styles: string): TFontStyles;
  65. function FontStylesToString(Styles: TFontStyles): string;
  66. function FontToString(Font: TFont): string;
  67. procedure StringToFont(const Str: string; Font: TFont);
  68. function RectToStr(Rect: TRect): string;
  69. function StrToRect(const Str: string; const Def: TRect): TRect;
  70. function PointToStr(P: TPoint): string;
  71. function StrToPoint(const Str: string; const Def: TPoint): TPoint;
  72.  
  73. function DefProfileName: string;
  74. function DefLocalProfileName: string;
  75.  
  76. const
  77.   idnListItem  = 'Item';
  78.  
  79. implementation
  80.  
  81. Uses SysUtils, Forms, rxStrUtils {$IFNDEF WIN32}, Str16 {$ENDIF};
  82.  
  83. const
  84.   idnListCount = 'Count';
  85.   idnDefString = #255#255;
  86.   Lefts  = ['[', '{', '('];
  87.   Rights = [']', '}', ')'];
  88.  
  89. { Utilities routines }
  90.  
  91. function DefLocalProfileName: string;
  92. begin
  93.   Result := ChangeFileExt(Application.ExeName, '.INI');
  94. end;
  95.  
  96. function DefProfileName: string;
  97. begin
  98.   Result := ExtractFileName(DefLocalProfileName);
  99. end;
  100.  
  101. function FontStylesToString(Styles: TFontStyles): string;
  102. begin
  103.   Result := '';
  104.   if fsBold in Styles then Result := Result + 'B';
  105.   if fsItalic in Styles then Result := Result + 'I';
  106.   if fsUnderline in Styles then Result := Result + 'U';
  107.   if fsStrikeOut in Styles then Result := Result + 'S';
  108. end;
  109.  
  110. function StringToFontStyles(const Styles: string): TFontStyles;
  111. begin
  112.   Result := [];
  113.   if Pos('B', UpperCase(Styles)) > 0 then Include(Result, fsBold);
  114.   if Pos('I', UpperCase(Styles)) > 0 then Include(Result, fsItalic);
  115.   if Pos('U', UpperCase(Styles)) > 0 then Include(Result, fsUnderline);
  116.   if Pos('S', UpperCase(Styles)) > 0 then Include(Result, fsStrikeOut);
  117. end;
  118.  
  119. function FontToString(Font: TFont): string;
  120. begin
  121.   with Font do
  122.     Result := Format('%s,%d,%s,%d,%s,%d', [Name, Size,
  123.       FontStylesToString(Style), Ord(Pitch), ColorToString(Color),
  124.       {$IFDEF RX_D3} Charset {$ELSE} 0 {$ENDIF}]);
  125. end;
  126.  
  127. type
  128.   THackFont = class(TFont);
  129.  
  130. procedure StringToFont(const Str: string; Font: TFont);
  131. const
  132.   Delims = [',', ';'];
  133. var
  134.   FontChange: TNotifyEvent;
  135.   Pos: Integer;
  136.   I: Byte;
  137.   S: string;
  138. begin
  139.   FontChange := Font.OnChange;
  140.   Font.OnChange := nil;
  141.   try
  142.     Pos := 1;
  143.     I := 0;
  144.     while Pos <= Length(Str) do begin
  145.       Inc(I);
  146.       S := Trim(ExtractSubstr(Str, Pos, Delims));
  147.       case I of
  148.         1: Font.Name := S;
  149.         2: Font.Size := StrToIntDef(S, Font.Size);
  150.         3: Font.Style := StringToFontStyles(S);
  151.         4: Font.Pitch := TFontPitch(StrToIntDef(S, Ord(Font.Pitch)));
  152.         5: Font.Color := StringToColor(S);
  153. {$IFDEF RX_D3}
  154.         6: Font.Charset := TFontCharset(StrToIntDef(S, Font.Charset));
  155. {$ENDIF}
  156.       end;
  157.     end;
  158.   finally
  159.     Font.OnChange := FontChange;
  160.     THackFont(Font).Changed;
  161.   end;
  162. end;
  163.  
  164. function RectToStr(Rect: TRect): string;
  165. begin
  166.   with Rect do
  167.     Result := Format('[%d,%d,%d,%d]', [Left, Top, Right, Bottom]);
  168. end;
  169.  
  170. function StrToRect(const Str: string; const Def: TRect): TRect;
  171. var
  172.   S: string;
  173.   Temp: string[10];
  174.   I: Integer;
  175. begin
  176.   Result := Def;
  177.   S := Str;
  178.   if (S[1] in Lefts) and (S[Length(S)] in Rights) then begin
  179.     Delete(S, 1, 1); SetLength(S, Length(S) - 1);
  180.   end;
  181.   I := Pos(',', S);
  182.   if I > 0 then begin
  183.     Temp := Trim(Copy(S, 1, I - 1));
  184.     Result.Left := StrToIntDef(Temp, Def.Left);
  185.     Delete(S, 1, I);
  186.     I := Pos(',', S);
  187.     if I > 0 then begin
  188.       Temp := Trim(Copy(S, 1, I - 1));
  189.       Result.Top := StrToIntDef(Temp, Def.Top);
  190.       Delete(S, 1, I);
  191.       I := Pos(',', S);
  192.       if I > 0 then begin
  193.         Temp := Trim(Copy(S, 1, I - 1));
  194.         Result.Right := StrToIntDef(Temp, Def.Right);
  195.         Delete(S, 1, I);
  196.         Temp := Trim(S);
  197.         Result.Bottom := StrToIntDef(Temp, Def.Bottom);
  198.       end;
  199.     end;
  200.   end;
  201. end;
  202.  
  203. function PointToStr(P: TPoint): string;
  204. begin
  205.   with P do Result := Format('[%d,%d]', [X, Y]);
  206. end;
  207.  
  208. function StrToPoint(const Str: string; const Def: TPoint): TPoint;
  209. var
  210.   S: string;
  211.   Temp: string[10];
  212.   I: Integer;
  213. begin
  214.   Result := Def;
  215.   S := Str;
  216.   if (S[1] in Lefts) and (S[Length(Str)] in Rights) then begin
  217.     Delete(S, 1, 1); SetLength(S, Length(S) - 1);
  218.   end;
  219.   I := Pos(',', S);
  220.   if I > 0 then begin
  221.     Temp := Trim(Copy(S, 1, I - 1));
  222.     Result.X := StrToIntDef(Temp, Def.X);
  223.     Delete(S, 1, I);
  224.     Temp := Trim(S);
  225.     Result.Y := StrToIntDef(Temp, Def.Y);
  226.   end;
  227. end;
  228.  
  229. { TRxIniFile }
  230.  
  231. constructor TRxIniFile.Create(const FileName: string);
  232. begin
  233.   inherited Create(FileName);
  234.   FListItemName :=idnListItem;
  235.   FOnReadObject := nil;
  236.   FOnWriteObject := nil;
  237. end;
  238.  
  239. destructor TRxIniFile.Destroy;
  240. begin
  241.   //if (FListItemName <> nil) and (FListItemName^ <> '') then Dispose(FListItemName);
  242.   inherited Destroy;
  243. end;
  244.  
  245. procedure TRxIniFile.Flush;
  246. var
  247. {$IFDEF WIN32}
  248.   CFileName: array[0..MAX_PATH] of WideChar;
  249. {$ELSE}
  250.   CFileName: array[0..127] of Char;
  251. {$ENDIF}
  252. begin
  253. {$IFDEF WIN32}
  254.   if (Win32Platform = VER_PLATFORM_WIN32_NT) then 
  255.     WritePrivateProfileStringW(nil, nil, nil, StringToWideChar(FileName,
  256.       CFileName, MAX_PATH))
  257.   else
  258.     WritePrivateProfileString(nil, nil, nil, PChar(FileName));
  259. {$ELSE}
  260.   WritePrivateProfileString(nil, nil, nil, StrPLCopy(CFileName,
  261.     FileName, SizeOf(CFileName) - 1));
  262. {$ENDIF}
  263. end;
  264.  
  265. {$IFNDEF WIN32}
  266. procedure TRxIniFile.DeleteKey(const Section, Ident: String);
  267. var
  268.   CSection: array[0..127] of Char;
  269.   CIdent: array[0..127] of Char;
  270.   CFileName: array[0..127] of Char;
  271. begin
  272.   WritePrivateProfileString(StrPLCopy(CSection, Section, SizeOf(CSection) - 1),
  273.     StrPLCopy(CIdent, Ident, SizeOf(CIdent) - 1), nil,
  274.     StrPLCopy(CFileName, FileName, SizeOf(CFileName) - 1));
  275. end;
  276. {$ENDIF}
  277.  
  278. function TRxIniFile.GetItemName: string;
  279. begin
  280.   Result := FListItemName;
  281. end;
  282.  
  283. procedure TRxIniFile.SetItemName(const Value: string);
  284. begin
  285.   FListItemName := Value;
  286. end;
  287.  
  288. procedure TRxIniFile.WriteObject(const Section, Item: string; Index: Integer;
  289.   Obj: TObject);
  290. begin
  291.   if Assigned(FOnWriteObject) then FOnWriteObject(Self, Section, Item, Obj);
  292. end;
  293.  
  294. function TRxIniFile.ReadObject(const Section, Item, Value: string): TObject;
  295. begin
  296.   Result := nil;
  297.   if Assigned(FOnReadObject) then Result := FOnReadObject(Self, Section, Item, Value);
  298. end;
  299.  
  300. procedure TRxIniFile.WriteList(const Section: string; List: TStrings);
  301. var
  302.   I: Integer;
  303. begin
  304.   EraseSection(Section);
  305.   WriteInteger(Section, idnListCount, List.Count);
  306.   for I := 0 to List.Count - 1 do begin
  307.     WriteString(Section, ListItemName + IntToStr(I), List[I]);
  308.     WriteObject(Section, ListItemName + IntToStr(I), I, List.Objects[I]);
  309.   end;
  310. end;
  311.  
  312. function TRxIniFile.ReadListParam(const Section: string; Append: Boolean;
  313.   List: TStrings): TStrings;
  314. var
  315.   I, IniCount: Integer;
  316.   AssString: string;
  317. begin
  318.   Result := List;
  319.   IniCount := ReadInteger(Section, idnListCount, -1);
  320.   if IniCount >= 0 then begin
  321.     if not Append then List.Clear;
  322.     for I := 0 to IniCount - 1 do begin
  323.       AssString := ReadString(Section, ListItemName + IntToStr(I), idnDefString);
  324.       if AssString <> idnDefString then
  325.         List.AddObject(AssString, ReadObject(Section, ListItemName +
  326.           IntToStr(I), AssString));
  327.     end;
  328.   end;
  329. end;
  330.  
  331. function TRxIniFile.ReadClearList(const Section: string; List: TStrings): TStrings;
  332. begin
  333.   Result := ReadListParam(Section, False, List);
  334. end;
  335.  
  336. function TRxIniFile.ReadList(const Section: string; List: TStrings): TStrings;
  337. begin
  338.   Result := ReadListParam(Section, True, List);
  339. end;
  340.  
  341. function TRxIniFile.ReadColor(const Section, Ident: string;
  342.   Default: TColor): TColor;
  343. begin
  344.   try
  345.     Result := StringToColor(ReadString(Section, Ident,
  346.       ColorToString(Default)));
  347.   except
  348.     Result := Default;
  349.   end;
  350. end;
  351.  
  352. procedure TRxIniFile.WriteColor(const Section, Ident: string; Value: TColor);
  353. begin
  354.   WriteString(Section, Ident, ColorToString(Value));
  355. end;
  356.  
  357. function TRxIniFile.ReadRect(const Section, Ident: string; const Default: TRect): TRect;
  358. begin
  359.   Result := StrToRect(ReadString(Section, Ident, RectToStr(Default)), Default);
  360. end;
  361.  
  362. procedure TRxIniFile.WriteRect(const Section, Ident: string; const Value: TRect);
  363. begin
  364.   WriteString(Section, Ident, RectToStr(Value));
  365. end;
  366.  
  367. function TRxIniFile.ReadPoint(const Section, Ident: string; const Default: TPoint): TPoint;
  368. begin
  369.   Result := StrToPoint(ReadString(Section, Ident, PointToStr(Default)), Default);
  370. end;
  371.  
  372. procedure TRxIniFile.WritePoint(const Section, Ident: string; const Value: TPoint);
  373. begin
  374.   WriteString(Section, Ident, PointToStr(Value));
  375. end;
  376.  
  377. function TRxIniFile.ReadFont(const Section, Ident: string; Font: TFont): TFont;
  378. begin
  379.   Result := Font;
  380.   try
  381.     StringToFont(ReadString(Section, Ident, FontToString(Font)), Result);
  382.   except
  383.     { do nothing, ignore any exceptions }
  384.   end;
  385. end;
  386.  
  387. procedure TRxIniFile.WriteFont(const Section, Ident: string; Font: TFont);
  388. begin
  389.   WriteString(Section, Ident, FontToString(Font));
  390. end;
  391.  
  392. end.